another experiment
Evangeline Reynolds
2025-12-23
ABCDEFGHIJKLMNOPQRSTVWXYZ abcdefghijklmnopqrstuvwxyz 🐒📊🚀
now I know my ABC’s, what’s next?
library(statexpress)
library(tidyverse)
update_geom_defaults(GeomPoint, aes(size = from_theme(pointsize * 3)))
#' @export
aes_default <- function(default = aes(x = 0)) {
structure(
list(
default_spec = default),
class = "aes_default"
)
}
#' @import ggplot2
#' @importFrom ggplot2 ggplot_add
#' @export
ggplot_add.aes_default <- function(object, plot, object_name) {
if(is.null(plot$mapping[[names(object$default_spec)]])){
plot <- plot + object$default_spec
}
plot
}
encode <- function(color, ...){
aes(color = {{color}}, fill = {{color}}, ...)
}
use <- encode
use_x <- function(x){list(aes(x = {{x}}))}
use_y <- function(y){list(aes(y = {{y}}))}
plot_data <- ggplot
use_weight <- function(weight){aes(weight = {{weight}})}
use_area <- function(area){aes(weight = {{area}})}
use_rows <- function(rows, cols, ...){facet_grid(rows = vars({{rows}}), cols = vars({{cols}}), ...)}
use_columns <- function(cols, rows, ...){facet_grid(rows = vars({{rows}}), cols = vars({{cols}}), ...)}
use_rows_columns <- function(rows, cols, ...){facet_grid(rows = vars({{rows}}), cols = vars({{cols}}), ...)}
use_wrap <- function(wrap, ...){facet_wrap(facets = vars({{wrap}}), ...)}
use_size <- function(size){aes(size = {{size}})}
use_shape <- function(shape){aes(shape = {{shape}})}
use_color <- function(color){aes(fill = {{color}})}
set_color <- function(color){aes(fill = I(color))}
use_color_line <- function(color){aes(color = {{color}})}
use_chart_point <- function(...){qlayer(geom = qproto_update(GeomPoint, aes(shape = 21),
required_aes = c()),
stat = qstat(function(data, scales){data$x <- data$x %||% 0 ; data$y <- data$y %||% 0; data}), ...)}
data <- function(data){ggplot(data |> remove_missing()) + theme_classic(ink = "darkgrey", paper = "whitesmoke", base_size = 18)}
chart_jitter <- geom_jitter
chart_heat <- function(...){list(
qlayer(geom = GeomTile,
stat = qproto_update(StatSum, aes(fill = after_stat(n), size = NULL)), ...),
scale_fill_gradientn(colors = c("blue", "white", "yellow", "orange", "red")),
theme(panel.grid.minor = element_line(color = "darkgrey")))
}
title <- function(title){labs(title = title)}
subtitle <- function(subtitle){labs(subtitle = subtitle)}
caption <- function(caption){labs(caption = caption)}
tag <- function(tag){labs(tag = tag)}
stamp_picture <- function(picture = "🙂", x = I(.5), y = I(.5), ...){
annotate(geom = GeomText, label = picture, x = x, y = y, ...)
}
pie of pets
chart_pie <- function(...){
list(
geom_bar(position = "fill", width = 1, show.legend = F, ...),
# add defaults that bar doesn't usually include
aes_default(aes(y = .5)),
aes_default(aes(fill = "All")),
aes_default(aes(weight = 1)),
aes_default(aes(color = from_theme(paper))),
# add labels
stat_count(geom = GeomLabel, color = "transparent",
position = position_fill(vjust = .5),
aes(label = after_stat(fill),
y = .9,
# group = after_stat(fill)
), alpha = 0,
show.legend = F,
size = 30
),
coord_polar(),
theme(axis.text = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank(),
axis.title = element_blank()),
labs(fill = NULL)
)
}
theme_kids <- theme_classic(paper = "whitesmoke",
ink = "darkgrey",
base_size = 30,
base_family = "Comic Sans MS")
theme_set(theme_kids)
pets_data <- data.frame(pets = c("🐱", "🐶", "🦚", "🐠", "🐰"),
number_of_pets = c(30, 25, 10, 15, 5)) |>
mutate(pets = fct_infreq(pets, number_of_pets) |> fct_rev())
pets_data
#> pets number_of_pets
#> 1 🐱 30
#> 2 🐶 25
#> 3 🦚 10
#> 4 🐠 15
#> 5 🐰 5
ggplot(pets_data) +
use_color(pets) +
use_area(number_of_pets) +
chart_pie()
A scatter of crustaceans
library(tidyverse)
types <- c("🦐", "🦀")
set.seed(1234)
ocean_table <- cars |>
rename(size = dist) |>
mutate(type = c(
rep("🦐", 20),
sample(types, 10, replace = T),
rep("🦀", 20))) |>
sample_frac()
GeomPointFill <-qproto_update(GeomPoint, aes(shape = 21),
required_aes = c())
library(statexpress)
chart_point <- function(...){
list(
qlayer(geom = GeomPointFill,
stat = qstat(function(data, scales){
# data$shape <- data$shape %||% data$picture
# data$x <- data$x %||% 0 ;
# data$y <- data$y %||% 0;
data}),
..., show.legend = F),
aes_default(aes(x = 0)),
aes_default(aes(y = 0)),
aes_default(aes(shape = I(after_stat(picture)))),
scale_size(range = c(2,10))
)
}
# should replace with lm xy
chart_fit_line <- function(...){
geom_smooth(method = lm, ..., show.legend = F, se = F,
linetype = "dashed",
aes(shape = NULL, picture = NULL))
}
use_picture <- function(picture){aes(shape = I({{picture}}))}head(ocean_table)
#> speed size type
#> 1 13 26 🦐
#> 2 7 22 🦐
#> 3 18 76 🦀
#> 4 20 32 🦀
#> 5 14 60 🦀
#> 6 15 54 🦀
ggplot(ocean_table) +
chart_point() +
use_y(speed) +
use_x(size) +
use_size(size) +
use_picture(type) +
chart_fit_line()
last_plot() +
labs(x = "little big") +
labs(y = "slow fast") +
theme(panel.background = element_rect(fill = "skyblue")) +
stamp_picture("🐉",
size = 40,
x = 100,
y = 10)
A jungle bar chart… ?
theme_chart_bar <- function(){
theme(panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
axis.ticks.x = element_blank())
}
chart_bar <- function(...){
list(geom_col(...),
theme_chart_bar(),
scale_y_continuous(expand = expansion(c(0, .3))),
labs(x = NULL))
}
compute_item_stack <- function(data, scales, width = 0.2){
data$shape <- data$shape %||% data$picture
data |>
uncount(y) |>
dplyr::mutate(row = row_number()) |>
dplyr::mutate(y = row -
0.5) |>
dplyr::mutate(width = width)
}
chart_item_stack <- function(...){
list(
qlayer(
geom = GeomPointFill,
stat = qstat(compute_item_stack)
),
qlayer(
geom = GeomTile,
stat = qstat(compute_item_stack),
alpha = 0
),
scale_y_continuous(expand = expansion(c(0, .3))),
aes_default(aes(y = 1)),
aes_default(aes(x = "All")),
labs(x = NULL)
)
}
ggprop.test:::compute_group_bricks
#> function (data, scales, width = 0.2)
#> {
#> data %>% dplyr::mutate(row = row_number()) %>% dplyr::mutate(y = row -
#> 0.5) %>% dplyr::mutate(width = width)
#> }
#> <bytecode: 0x136423158>
#> <environment: namespace:ggprop.test>
jungle_table <- data.frame(tree = paste0("🌴#", 1:5),
num_bunches = c(2, 5, 1, 2, 1),
banana = "🍌")
jungle_table |>
select(x = tree, y = num_bunches, picture = banana) |>
compute_item_stack()
#> x picture shape row y width
#> 1 🌴#1 🍌 🍌 1 0.5 0.2
#> 2 🌴#1 🍌 🍌 2 1.5 0.2
#> 3 🌴#2 🍌 🍌 3 2.5 0.2
#> 4 🌴#2 🍌 🍌 4 3.5 0.2
#> 5 🌴#2 🍌 🍌 5 4.5 0.2
#> 6 🌴#2 🍌 🍌 6 5.5 0.2
#> 7 🌴#2 🍌 🍌 7 6.5 0.2
#> 8 🌴#3 🍌 🍌 8 7.5 0.2
#> 9 🌴#4 🍌 🍌 9 8.5 0.2
#> 10 🌴#4 🍌 🍌 10 9.5 0.2
#> 11 🌴#5 🍌 🍌 11 10.5 0.2
# last_plot() +
# annotate(geom = GeomText,
# x = I(.75), y = I(.72),
# label = "🎈🎀🙏",
# angle = -10,
# size = 22,
# ) jungle_table
#> tree num_bunches banana
#> 1 🌴#1 2 🍌
#> 2 🌴#2 5 🍌
#> 3 🌴#3 1 🍌
#> 4 🌴#4 2 🍌
#> 5 🌴#5 1 🍌
ggplot(jungle_table) +
chart_item_stack() +
use(x = tree,
y = num_bunches,
picture = banana) + # you could also use "🍌"
chart_item_stack()
last_plot() +
stamp_picture("🐒",
size = 40,
x = I(.95),
y = I(.15)) +
coord_cartesian(clip = "off")
head(jungle_table)
#> tree num_bunches banana
#> 1 🌴#1 2 🍌
#> 2 🌴#2 5 🍌
#> 3 🌴#3 1 🍌
#> 4 🌴#4 2 🍌
#> 5 🌴#5 1 🍌
ggplot(jungle_table) +
encode(x = tree,
y = num_bunches) +
chart_bar(fill = "gold")
Polar Bears
chart_bar_plunging <- function(...){
list(geom_col(...),
theme_chart_bar(),
scale_y_reverse(expand = expansion(c(.3, 0))),
scale_x_discrete(position = "top"),
labs(x = NULL),
geom_label(vjust = 1, aes(label = after_stat(y)),
linewidth = 0)
)
}
bears <- paste0("🐻❄️ #", 1:5)
depth <- c(3,5,4,6,5)
polar_bear_table <- data_frame(bears, depth)
polar_bear_table
#> # A tibble: 5 × 2
#> bears depth
#> <chr> <dbl>
#> 1 🐻❄️ #1 3
#> 2 🐻❄️ #2 5
#> 3 🐻❄️ #3 4
#> 4 🐻❄️ #4 6
#> 5 🐻❄️ #5 5
# clearhistory()
bear_table <- tribble(~id_bear, ~depth,
"🐻❄️#1", 3,
"🐻❄️#2", 5,
"🐻❄️#3", 4,
"🐻❄️#4", 6,
"🐻❄️#5", 5)
#'
ggplot(bear_table) +
use(x = bears, y = depth) +
chart_bar_plunging(
fill = "lightblue1"
) 
# ggram(title = "Daphne's North Pole plot")
digging
time <- c(0, 15, 30, 45, 60)
num_tunnels <- c(0, 4, 5, 5.5, 5.9)
fork_and_spoon_table <- data_frame(time, num_tunnels, type = "🍴")
shovel_and_bucket_table <- data_frame(time, num_tunnels = num_tunnels * 2, type = "🪣")
paws_table <- data_frame(time, num_tunnels = num_tunnels * 3, type = "🐾")
chart_line <- geom_line
digging_table <- fork_and_spoon_table |>
bind_rows(shovel_and_bucket_table) |>
bind_rows(paws_table)
ggplot(digging_table) +
use_x(time) +
use_y(num_tunnels) +
use(picture = type) +
chart_line() +
chart_point() +
labs(x = "⏱️")
Shuttles (future work)
outer_space_data <- data.frame(shuttle = paste0("🚀 #", 1:6), fuel = c(.3,.5,.3, .8,.7, .4))
chart_part_of_full <- function(...){
list(
geom_col(fill = "transparent", aes(y = 1)),
geom_col( ... ),
aes_default(aes(color = from_theme(ink)))
)
}
stamp_hline <- function(y = .5, linetype = "dashed", ...){
geom_hline(yintercept = y, linetype = linetype, ...)
}outer_space_data
#> shuttle fuel
#> 1 🚀 #1 0.3
#> 2 🚀 #2 0.5
#> 3 🚀 #3 0.3
#> 4 🚀 #4 0.8
#> 5 🚀 #5 0.7
#> 6 🚀 #6 0.4
ggplot(outer_space_data) +
use(x = shuttle,
y = fuel) +
chart_part_of_full(fill = "darkolivegreen3") +
stamp_hline(.75)
last_plot() +
stamp_picture("👽",
angle = 25,
size = 40,
x = I(.95),
y = I(.15)) +
coord_cartesian(clip = "off")
scooter repair
weeks <- c(0,1,2)
num_coins <- c(1,2,3)
coin <- c("🪙", "🪙🪙", "🪙🪙🪙")
scooter_table <- tibble(weeks, num_coins, coin)
compute_panel_count <- function(data, scales){
data |>
uncount(y, .remove = F)
}
scooter_table |>
select(x = weeks, y = num_coins) |>
compute_panel_count()
#> # A tibble: 6 × 2
#> x y
#> <dbl> <dbl>
#> 1 0 1
#> 2 1 2
#> 3 1 2
#> 4 2 3
#> 5 2 3
#> 6 2 3
chart_point_count <- function(...){
list(
qlayer(geom = GeomPointFill,
stat = qstat(compute_panel = compute_panel_count),
position = position_jitter(width = .12, height = .12),
..., show.legend = F),
aes_default(aes(x = 0)),
aes_default(aes(y = 0)),
aes_default(aes(shape = I(after_stat(picture)))),
scale_size(range = c(2,10))
)
}
scooter_table
#> # A tibble: 3 × 3
#> weeks num_coins coin
#> <dbl> <dbl> <chr>
#> 1 0 1 🪙
#> 2 1 2 🪙🪙
#> 3 2 3 🪙🪙🪙
set.seed(12345)
ggplot(scooter_table) +
use_x(weeks) +
use_y(num_coins) +
use_picture("🪙") +
chart_line() +
chart_point_count() +
stamp_hline(2.25)
last_plot() +
stamp_picture("🛴",
y = 2.45,
x = 1.9,
size = 45,
angle = 10)
knitr::knit_exit()